home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Oberon
/
source
/
Library
/
Strings.mod
< prev
next >
Wrap
Text File
|
1995-06-29
|
5KB
|
219 lines
(***************************************************************************
$RCSfile: Strings.mod $
Description: String manipulation
Created by: fjc (Frank Copeland)
$Revision: 1.10 $
$Author: fjc $
$Date: 1995/06/04 23:22:41 $
Copyright © 1994, Frank Copeland.
This file is part of the Oberon-A Library.
See Oberon-A.doc for conditions of use and distribution.
***************************************************************************)
<*$ IndexChk- *>
(* Index checking is handled explicitly by the relevant procedures. *)
MODULE Strings;
IMPORT SYS := SYSTEM;
PROCEDURE Min ( a, b : INTEGER ) : INTEGER;
BEGIN (* Min *)
IF a < b THEN RETURN a
ELSE RETURN b
END
END Min;
PROCEDURE Length *
( s : ARRAY OF CHAR )
: INTEGER;
VAR len : INTEGER;
<*$CopyArrays-*>
BEGIN (* Length *)
len := SHORT (SYS.STRLEN (s));
RETURN Min (SHORT (LEN (s)), len)
END Length;
PROCEDURE Append *
( extra : ARRAY OF CHAR;
VAR dest : ARRAY OF CHAR );
VAR max, len1, len2 : INTEGER;
<*$CopyArrays-*>
BEGIN (* Append *)
len1 := Length (dest); max := SHORT (LEN (dest)); DEC (max);
IF len1 < max THEN
(* There is actually room at the end of the array. *)
len2 := Min (len1 + Length (extra), max);
SYS.MOVE (SYS.ADR (extra), SYS.ADR (dest [len1]), len2 - len1 );
dest [len2] := 0X;
END
END Append;
PROCEDURE Insert *
( source : ARRAY OF CHAR;
pos : INTEGER;
VAR dest : ARRAY OF CHAR );
VAR max, len1, len2 : INTEGER;
<*$CopyArrays-*>
BEGIN (* Insert *)
len1 := Length (source); len2 := Length (dest);
max := SHORT (LEN (dest)); DEC (max);
IF (pos >= len2) THEN
(* The start position is past the end of the target string. *)
Append (dest, source)
ELSIF ((len1 + len2) <= max) THEN
(*
The result will fit into the target string. Move characters towards
the end of the string to make room and copy the new characters into
the space.
*)
SYS.MOVE
( SYS.ADR (dest [pos]), SYS.ADR (dest [pos + len1]), len2 - pos );
SYS.MOVE (SYS.ADR (source), SYS.ADR (dest [pos]), len1);
dest [len2 + len1] := 0X
ELSIF ((pos + len1) < max) THEN
(*
The result will overflow the target string, but the subString will
fit. Move characters towards the end of the string to make room and
copy the new characters into the space.
*)
SYS.MOVE
( SYS.ADR (dest [pos]), SYS.ADR (dest [pos + len1]),
max - len1 - pos );
SYS.MOVE ( SYS.ADR (source), SYS.ADR (dest [pos]), len1 );
dest [max] := 0X
ELSE
(*
The result will overflow the target string, and the subString is too
long to fit. Just discard the end of the target string and append
the new characters to it.
*)
dest [pos] := 0X; Append (dest, source)
END
END Insert;
PROCEDURE Delete *
( VAR s : ARRAY OF CHAR;
pos, n : INTEGER );
VAR len : INTEGER;
BEGIN (* Delete *)
IF n > 0 THEN
len := Length (s);
IF pos < len THEN
IF (pos + n) < len THEN
(* Move characters towards the front of the array into the space
** deleted.
*)
SYS.MOVE
( SYS.ADR (s [pos + n]), SYS.ADR (s [pos]), len - (pos + n) );
s [len - n] := 0X;
ELSE (* Delete to the end of the string. *)
s [pos] := 0X;
END
END
END
END Delete;
PROCEDURE Replace *
( source : ARRAY OF CHAR;
pos : INTEGER;
VAR dest : ARRAY OF CHAR );
<*$CopyArrays-*>
BEGIN (* Replace *)
Delete (dest, pos, Length (source)); Insert (source, pos, dest)
END Replace;
PROCEDURE Extract *
( source : ARRAY OF CHAR;
pos, n : INTEGER;
VAR dest : ARRAY OF CHAR );
VAR len1, len2 : INTEGER;
<*$CopyArrays-*>
BEGIN (* Extract *)
len2 := 0;
IF n > 0 THEN
len1 := Length (source);
IF (pos < len1) THEN
len2 := Min ( Min (n, SHORT (LEN (dest)) - 1), len1 - pos);
SYS.MOVE (SYS.ADR (source [pos]), SYS.ADR (dest), len2);
END
END;
dest [len2] := 0X;
END Extract;
PROCEDURE Pos *
( pattern, s : ARRAY OF CHAR;
pos : INTEGER )
: INTEGER;
VAR
result, i, len1, len2 : INTEGER;
found, match : BOOLEAN;
<*$CopyArrays-*>
BEGIN (* Pos *)
result := -1;
IF pos >= 0 THEN
len1 := Length (pattern); len2 := Length (s);
IF (len1 = 0) OR (len2 = 0) OR (pos >= len2) THEN
result := -1
ELSE
found := FALSE;
WHILE ~found & ((len2 - pos) >= len1) DO
IF s [pos] = pattern [0] THEN
match := TRUE; i := 0;
WHILE match & (i < len1) DO
IF s [pos + i] = pattern [i] THEN INC (i)
ELSE match := FALSE
END
END;
found := match
ELSE
INC (pos)
END
END;
IF found THEN result := pos END
END
END;
RETURN result
END Pos;
PROCEDURE Cap *
( VAR s : ARRAY OF CHAR );
VAR index : INTEGER; ch : CHAR;
BEGIN (* Cap *)
index := 0; ch := s [0];
WHILE ch # 0X DO
s [index] := CAP (ch); INC (index); ch := s [index]
END
END Cap;
END Strings.